home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / MACROS / LISTS.PAS next >
Pascal/Delphi Source File  |  1992-01-29  |  6KB  |  218 lines

  1. Unit Lists;
  2. (***************************************************************************
  3.           Implements a generic Stack Object and Queue Object.
  4.           Copyright 1992 Cybersoft - All Rights Reserved.
  5.  ***************************************************************************)
  6.  
  7. {
  8. The stack is a singly linked list. An object of TYPE = TSTACK is implemented.
  9. Methods include Init, Done, Push and Pop. Fields include Head (of the stack),
  10. and Size (of the data record, set with Init).
  11.  
  12. The queue is a circular doubly linked list, for easy insertion at the tail,
  13. and easy extraction from the head. An object of TYPE = TQUEUE is implemented.
  14. Methods include Init, Done, Insert and Extract. Fields include Head (of the
  15. queue), and Size (of the data record, set with Init).
  16.  
  17. Both objects receive and return pointers to PRE-ALLOCATED data records. It
  18. is up the programmer to allocate and deallocate the pointers to the data
  19. records.
  20. }
  21.  
  22. interface
  23.  
  24. type
  25.      (* ---- STACKS ---- *)
  26.  
  27.      PStackItem = ^TStackItem;
  28.      TStackItem = record
  29.                     Next: PStackItem;     { To successor     }
  30.                     Data: Pointer;
  31.                   end;
  32.  
  33.      PStack = ^TStack;
  34.      TStack = object
  35.                 Head    : PStackItem;
  36.                 RecSize : Integer;
  37.                 NotEmpty      : boolean;
  38.  
  39.                 constructor Init (RecordSize : Integer);
  40.                 destructor Done; virtual;
  41.                 procedure Push (Item : Pointer);
  42.                 function Pop : Pointer;
  43.               end;
  44.  
  45.  
  46.      (* ---- QUEUES ---- *)
  47.  
  48.      PQueueItem = ^TQueueItem;
  49.      TQueueItem = record
  50.                     Prev, Next : PQueueItem;
  51.                     Data       : Pointer;
  52.                   end;
  53.  
  54.      PQueue = ^TQueue;
  55.      TQueue = object
  56.                 Head    : PQueueItem;
  57.                 RecSize : Integer;
  58.                 NotEmpty      : boolean;
  59.  
  60.                 constructor Init (RecordSize : Integer);
  61.                 destructor Done; virtual;
  62.                 procedure Insert (Item : Pointer);
  63.                 function Extract : Pointer;
  64.               end;
  65.  
  66. implementation
  67.  
  68. (* ------------------------------- STACK -------------------------------- *)
  69.  
  70. constructor TStack.Init (RecordSize : Integer);
  71. begin
  72.   Head := nil;
  73.   RecSize := RecordSize;
  74.   NotEmpty := false;
  75. end;
  76.  
  77.  
  78. {Disposes of entire stack}
  79.  
  80. destructor TStack.Done;
  81. var P : PStackItem;
  82. begin
  83.   while Head <> nil do
  84.   begin
  85.     P := Head;
  86.     Head := P^.Next;
  87.     if P <> nil then
  88.     begin
  89.       FreeMem (P^.Data, RecSize);
  90.       dispose (P);
  91.     end;
  92.   end;
  93.   NotEmpty := false;
  94. end;
  95.  
  96.  
  97. {Item is a pointer to a data record of any type, size of TStack.RecSize}
  98.  
  99. procedure TStack.Push (Item : Pointer);
  100. var P : PStackItem;
  101. begin
  102.   new (P);
  103.   if Head <> nil then P^.Next := Head else P^.Next := nil;
  104.   Head := P;
  105.   Head^.Data := Item;
  106.   NotEmpty := true;
  107. end;
  108.  
  109.  
  110.  
  111. {Pops the item off the stack, and returns a pointer to the data record, and
  112.  removes the item from the stack. If the stack is empty, nil is returned.}
  113.  
  114. Function TStack.Pop : Pointer;
  115. var P : PStackItem;
  116. begin
  117.   if Head = nil then
  118.   begin
  119.     Pop := nil;
  120.     exit;
  121.   end;
  122.   Pop := Head^.Data;
  123.   P := Head^.Next;
  124.   dispose (Head);
  125.   Head := P;
  126.   if P = nil then NotEmpty := false;
  127. end;
  128.  
  129.  
  130. (* ------------------------------- QUEUE -------------------------------- *)
  131.  
  132. constructor TQueue.Init (RecordSize : Integer);
  133. begin
  134.   RecSize := RecordSize;
  135.   Head := nil;
  136.   NotEmpty := false;
  137. end;
  138.  
  139.  
  140. {disposes of the entire queue by popping off and disposing the head.}
  141.  
  142. destructor TQueue.Done;
  143. var Next, Prev : PQueueItem;
  144. begin
  145.   if Head = nil then exit;                      { Queue is empty.          }
  146.   while Head^.Next <> Head do                   { 2 or more items in queue.}
  147.   begin
  148.     Next := Head^.Next;
  149.     Prev := Head^.Prev;
  150.     Next^.Prev := Prev;
  151.     Prev^.Next := Next;
  152.     FreeMem (Head^.Data, RecSize);
  153.     dispose (Head);
  154.     Head := Next;
  155.   end;
  156.   FreeMem (Head^.Data, RecSize);                { Head is the only item.  }
  157.   dispose (Head);
  158.   Head := nil;
  159.   NotEmpty := false;
  160. end;
  161.  
  162.  
  163. { Inserts item at the tail of the queue. }
  164.  
  165. procedure TQueue.Insert (Item : Pointer);
  166. var P : PQueueItem;
  167. begin
  168.   new (P);
  169.   P^.Data := Item;
  170.  
  171.   if Head <> nil then                           { Queue is not empty.     }
  172.   begin
  173.     P^.Prev := Head^.Prev;
  174.     P^.Next := Head;
  175.     Head^.Prev^.Next := P;
  176.     Head^.Prev := P;
  177.   end
  178.   else                                          { Queue is empty.         }
  179.   begin                                         
  180.     Head := P;
  181.     P^.Next := P;
  182.     P^.Prev := P;
  183.   end;
  184.  
  185.   NotEmpty := true;                                   { Queue is not empty.     }
  186.  
  187. end;
  188.  
  189.  
  190. { Returns pointer to data record of item at the head of the queue, and
  191.   replaces/disposes of Queue Head item, moving the queue up 1 item. }
  192.  
  193. function TQueue.Extract : Pointer;
  194. var P : PQueueItem;
  195. begin
  196.   if Head <> nil then                    {at least one item}
  197.   begin
  198.     Extract := Head^.Data;
  199.     if Head^.Next <> Head then           {more than one item}
  200.     begin
  201.       P := Head;
  202.       Head := P^.Next;
  203.       Head^.Prev := P^.Prev;
  204.       P^.Prev^.Next := Head;
  205.       dispose (P);
  206.     end
  207.     else
  208.     begin                                {only one item}
  209.       dispose (Head);
  210.       Head := nil;
  211.       NotEmpty := false;
  212.     end;
  213.   end
  214.   else
  215.     Extract := nil;
  216. end;
  217.  
  218. end.